R Notebook

if(!require("plotly")) {install.packages("plotly")}

# install.packages("latex2exp")
# install.packages("BiocManager") 
# install.packages("corrplot")
# BiocManager::install("EBImage")

if(!require("lme4")){install.packages("lme4")}
if(!require("lmerTest")){install.packages("lmerTest")}
if(!require("nlme")){install.packages("nlme")}
if(!require("formattable")){install.packages("formattable")}
if(!require("xgboost")){install.packages("xgboost")}
if(!require("processx")) {install.packages("processx")}

library(plotly)
library(lme4)
library(lmerTest)
library(nlme)
library(formattable)
library(xgboost)

### Load libraries
library(EBImage)
library(ggplot2)
library(stringr)
library(gridExtra)
library(latex2exp)
packageVersion('plotly')

[1] ‘4.9.1’

Sys.setenv("plotly_username"="thuynh32")
Sys.setenv("plotly_api_key"="xcSv1yzujDc1IGEwQlr2")

colorBlue = "#007fff"
colorRed = "#ff7f7f"
colorGray = "#cccccc"
colorGreen = "#11ff00"

all_Drive1 <- read.csv('../../../data/TT1/preprocessed/All/TT1_Drive_1_30m_30m.csv')
all_Drive1$Subject <- as.factor(all_Drive1$Subject)
all_Drive1$logPerspiration <- log(all_Drive1$Perspiration)


persons         = c("01",  "02", "03", "04", "05",  "06",  "07", 
                    "09",  "12", "13", "15", "16",  "17",  "18", 
                    "22",  "24", "29", "30", "31",  "32",  "41")

mean_pp <- vector(mode="list", length=length(persons)) 
names(mean_pp) <- persons

std_pp <- vector(mode="list", length=length(persons)) 
names(std_pp) <- persons

# Segments
mean_pp_seg0 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg0) <- persons
mean_pp_seg1 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg1) <- persons
mean_pp_seg2 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg2) <- persons
mean_pp_seg3 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg3) <- persons
mean_pp_seg4 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg4) <- persons


for(p in persons) {
  pData <- all_Drive1[(all_Drive1$Subject==as.integer(p) | all_Drive1$Subject==p),]
  pData_act1 <- pData[pData$Activity == 1,]
  
  if(p == "41") {
    # This subjest has suspecious PP in the last phase (Phase = 4)
    pData_seg0 <- pData[pData$Phase==0 & pData$Time <= 370,]
  } else {
    pData_seg0 <- pData[pData$Phase==0,]
  }
  
  pData_seg1 <- pData[pData$Phase==1 & pData$Activity==1 & pData$Time < 110,]
  pData_seg2 <- pData[pData$Phase==2 & pData$Activity==1 & pData$Time < 250,]
  pData_seg3 <- pData[pData$Phase==3 & pData$Activity==1 & pData$Time < 350,]
  pData_seg4 <- pData[pData$Phase==4 & pData$Activity==1,]
  
  if(p == "41") {
    # This subjest has suspecious PP in the last phase (Phase = 4)
    mean_pp[[p]] <- mean(pData_act1[pData_act1$Time <= 370,]$ppLogNormalized)
  } else {
    mean_pp[[p]] <- mean(pData_act1$ppLogNormalized)
  }
  
  std_pp[[p]] <- sd(pData$ppLogNormalized)
  mean_pp_seg0[[p]] <- mean(pData_seg0$ppLogNormalized)
  mean_pp_seg1[[p]] <- mean(pData_seg1$ppLogNormalized)
  mean_pp_seg2[[p]] <- mean(pData_seg2$ppLogNormalized)
  mean_pp_seg3[[p]] <- mean(pData_seg3$ppLogNormalized)
  
  if (p == "41") {
    mean_pp_seg4[[p]] <- mean_pp[[p]]
  } else {
    mean_pp_seg4[[p]] <- mean(pData_seg4$ppLogNormalized)
  }
}

plt_AllAcc <- vector(mode="list", length=length(persons)) 
names(plt_AllAcc) <- persons

COLOR_ACC = "#02A3C8"
COLOR_PP = "#F28E8E"
COLOR_BRAKE = "#888888"

y1 <- list(
  tickfont = list(color = COLOR_ACC),
  title="Degree",
  range=c(0, max(all_Drive1$Acceleration))
)
y2 <- list(
  tickfont = list(color = COLOR_PP),
  overlaying = "y",
  side = "right",
  title = "Log Perspiration",
  showgrid = FALSE,
  range=c(min(all_Drive1$ppLogNormalized), max(all_Drive1$ppLogNormalized))
)

for (p in persons) {
  pData <- all_Drive1[all_Drive1$Subject==as.integer(p) | all_Drive1$Subject==p,]
  
  pData_seg0 <- pData[pData$Phase==0,]
  pData_seg1 <- pData[pData$Phase==1 & pData$Activity==1 & pData$Time < 110,]
  pData_seg2 <- pData[pData$Phase==2 & pData$Activity==1 & pData$Time < 250,]
  pData_seg3 <- pData[pData$Phase==3 & pData$Activity==1 & pData$Time < 350,]
  pData_seg4 <- pData[pData$Phase==4 & pData$Activity==1,]
  
  plot_Acc <- plot_ly(pData, x = ~Time, height=400, width=900) %>%
    # add_trace(name="Acceleration", y = ~Acceleration, type = 'scatter', mode = 'lines', line=list(width=1.5, color=COLOR_ACC)) %>% 
    add_trace(name="PP", y = ~ppLogNormalized, type = 'scatter', mode = 'lines', connectgaps=F, line=list(width=1.5, color=COLOR_PP), yaxis = "y2") %>%
    add_segments(x = min(pData$Time), xend = max(pData$Time), y = mean_pp[[p]], yend = mean_pp[[p]],
                           yaxis = "y2", name="Avg. PP (straight)",
                           line=list(color="darkgray", dash = 'dot')) %>%
    add_segments(x = min(pData$Time), xend = max(pData$Time), y = mean_pp_seg0[[p]], yend = mean_pp_seg0[[p]], 
                           yaxis = "y2", name="Avg. PP (turning)",
                           line=list(color="black", dash = 'dot')) %>%
    add_segments(x = min(pData_seg1$Time), xend = max(pData_seg1$Time), y = mean_pp_seg1[[p]], yend = mean_pp_seg1[[p]], 
                           yaxis = "y2", name="Avg. PP (1st part)",
                           line=list(color="red", dash = 'dot')) %>%
    add_segments(x = min(pData_seg2$Time), xend = max(pData_seg2$Time), y = mean_pp_seg2[[p]], yend = mean_pp_seg2[[p]], 
                           yaxis = "y2", name="Avg. PP (2nd part)",
                           line=list(color="green", dash = 'dot')) %>%
    add_segments(x = min(pData_seg3$Time), xend = max(pData_seg3$Time), y = mean_pp_seg3[[p]], yend = mean_pp_seg3[[p]], 
                           yaxis = "y2", name="Avg. PP (3rd part)",
                           line=list(color="blue", dash = 'dot')) %>%
    add_segments(x = min(pData_seg4$Time), xend = max(pData_seg4$Time), y = mean_pp_seg4[[p]], yend = mean_pp_seg4[[p]], 
                           yaxis = "y2", name="Avg. PP (4th part)",
                           line=list(color="purple", dash = 'dot')) %>%
    layout(
      title=paste0("Subject #", p), 
      xaxis=list(title="Time [s]", range=c(0)), 
      yaxis=y1, 
      yaxis2=y2, 
      margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4),
      legend = list(x = 0.5, xanchor = "center", y = 0.2, bgcolor = "rgba(0,0,0,0)", title="Metric", orientation = "h"),
      autosize = F
    )
  
  plt_AllAcc[[p]] <- plot_Acc
}


htmltools::tagList(plt_AllAcc)

library(dendextend)

NUMBER_OF_CLUSTERS = 4

color_darkpink = "#e75480"
CLUSTER_BRANCH_COLORS <- c("blue", "darkred", color_darkpink, "black")[1:NUMBER_OF_CLUSTERS]
CLUSTER_LABEL_COLORS <- c("blue", "darkred", color_darkpink, "black")[1:NUMBER_OF_CLUSTERS]


dfPP <- as.data.frame(cbind(
                            unlist(mean_pp), 
                            unlist(std_pp), 
                            unlist(mean_pp_seg0), 
                            unlist(mean_pp_seg1), 
                            unlist(mean_pp_seg2), 
                            unlist(mean_pp_seg3), 
                            unlist(mean_pp_seg4)))

names(dfPP) <- c("MeanPP", "StdPP", "MeanPP_Seg0", "MeanPP_Seg1", "MeanPP_Seg2", "MeanPP_Seg3", "MeanPP_Seg4")
behavioralMatrixClustering <- as.matrix(dfPP)

distMatrix <- dist(behavioralMatrixClustering)
hresults <- distMatrix %>% hclust

hc <- hresults %>% 
      as.dendrogram %>%
      set("nodes_cex", NUMBER_OF_CLUSTERS) %>%
      set("labels_col", value = CLUSTER_LABEL_COLORS, k=NUMBER_OF_CLUSTERS) %>%
      # set("leaves_pch", 19) %>%
      # set("leaves_col", value = c("gray"), k=NUMBER_OF_CLUSTERS) %>%    
      set("branches_k_color", value=CLUSTER_BRANCH_COLORS, k=NUMBER_OF_CLUSTERS)

plot(hc)
legend("topright", 
     title="Drive=Cognitive \nHierachical Clustering",
     legend = c("Exceptional Increase of PP" , "Slightly Increase of PP" , "No-change or Decrease of PP"), 
     col = c("darkred", "pink" , "blue"),
     pch = c(20,20,20), bty = "n",  pt.cex = 1.5, cex = 0.8 , 
     text.col = "black", horiz = FALSE, inset = c(0.4, 0.1))

# Store clustering data
fPath <- str_interp("../../../data/TT1/preprocessed/Analysis/TT1_Drive_1_PP.csv")
dfx <- dfPP
dfx <- cbind(persons, dfx)
names(dfx) <- c("Subject", names(dfPP))
write.csv(dfx, fPath, row.names = F)